home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_emacs.idb / usr / freeware / share / emacs / 19.34 / lisp / gnus-vm.el.z / gnus-vm.el
Encoding:
Text File  |  1998-10-28  |  3.4 KB  |  112 lines
  1. ;;; gnus-vm.el --- vm interface for Gnus
  2. ;; Copyright (C) 1994,95,96 Free Software Foundation, Inc.
  3.  
  4. ;; Author: Per Persson <pp@solace.mh.se>
  5. ;; Keywords: news, mail
  6.  
  7. ;; This file is part of GNU Emacs.
  8.  
  9. ;; GNU Emacs is free software; you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13.  
  14. ;; GNU Emacs is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17. ;; GNU General Public License for more details.
  18.  
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22. ;; Boston, MA 02111-1307, USA.
  23.  
  24. ;;; Commentary:
  25.  
  26. ;; Major contributors: 
  27. ;;    Christian Limpach <Christian.Limpach@nice.ch>
  28. ;; Some code stolen from: 
  29. ;;    Rick Sladkey <jrs@world.std.com>
  30.  
  31. ;;; Code:
  32.  
  33. (require 'sendmail)
  34. (require 'message)
  35. (require 'gnus)
  36. (require 'gnus-msg)
  37.  
  38. (eval-when-compile
  39.   (autoload 'vm-mode "vm")
  40.   (autoload 'vm-save-message "vm")
  41.   (autoload 'vm-forward-message "vm")
  42.   (autoload 'vm-reply "vm")
  43.   (autoload 'vm-mail "vm"))
  44.  
  45. (defvar gnus-vm-inhibit-window-system nil
  46.   "Inhibit loading `win-vm' if using a window-system.
  47. Has to be set before gnus-vm is loaded.")
  48.  
  49. (or gnus-vm-inhibit-window-system
  50.     (condition-case nil
  51.     (if window-system
  52.         (require 'win-vm))
  53.       (error nil)))
  54.  
  55. (if (not (featurep 'vm))
  56.     (load "vm"))
  57.  
  58. (defun gnus-vm-make-folder (&optional buffer)
  59.   (let ((article (or buffer (current-buffer)))
  60.     (tmp-folder (generate-new-buffer " *tmp-folder*"))
  61.     (start (point-min))
  62.     (end (point-max)))
  63.     (set-buffer tmp-folder)
  64.     (insert-buffer-substring article start end)
  65.     (goto-char (point-min))
  66.     (if (looking-at "^\\(From [^ ]+ \\).*$")
  67.     (replace-match (concat "\\1" (current-time-string)))
  68.       (insert "From " gnus-newsgroup-name " "
  69.           (current-time-string) "\n"))
  70.     (while (re-search-forward "\n\nFrom " nil t)
  71.       (replace-match "\n\n>From "))
  72.     ;; insert a newline, otherwise the last line gets lost
  73.     (goto-char (point-max))
  74.     (insert "\n")
  75.     (vm-mode)
  76.     tmp-folder))
  77.   
  78. (defun gnus-summary-save-article-vm (&optional arg)
  79.   "Append the current article to a vm folder.
  80. If N is a positive number, save the N next articles.
  81. If N is a negative number, save the N previous articles.
  82. If N is nil and any articles have been marked with the process mark,
  83. save those articles instead."
  84.   (interactive "P")
  85.   (let ((gnus-default-article-saver 'gnus-summary-save-in-vm))
  86.     (gnus-summary-save-article arg)))
  87.  
  88. (defun gnus-summary-save-in-vm (&optional folder)
  89.   (interactive)
  90.   (let ((default-name
  91.       (funcall gnus-mail-save-name gnus-newsgroup-name
  92.            gnus-current-headers gnus-newsgroup-last-mail)))
  93.     (setq folder
  94.       (cond ((eq folder 'default) default-name)
  95.         (folder folder)
  96.         (t (gnus-read-save-file-name 
  97.             "Save article in VM folder:" default-name))))
  98.     (gnus-make-directory (file-name-directory folder))
  99.     (set-buffer gnus-original-article-buffer)
  100.     (save-excursion
  101.       (save-restriction
  102.     (widen)
  103.     (let ((vm-folder (gnus-vm-make-folder)))
  104.       (vm-save-message folder)
  105.       (kill-buffer vm-folder))))
  106.     ;; Remember the directory name to save articles.
  107.     (setq gnus-newsgroup-last-mail folder)))
  108.  
  109. (provide 'gnus-vm)
  110.  
  111. ;;; gnus-vm.el ends here.
  112.